home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / 173amrg.zip / RSB5173A.MRG < prev    next >
Text File  |  1990-08-26  |  27KB  |  654 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against D:\172B\RBBSSUB5.BAS to produce RBBSSUB5.BAS
  3. * D:\172B\RBBSSUB5.BAS:  Date 2-10-1990  Size 86814 bytes
  4. * ------------[ Created 08-26-1990 11:33:08 ]------------
  5. * REPLACING old line(s) by new
  6. ' $linesize:132
  7. * ------[ first line different ]------
  8. ' $title: 'RBBSSUB5.BAS 17.3A, Copyright 1986 - 90 by D. Thomas Mack' ' DA081003
  9. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  10. '  Name ...............: RBBSSUB5.BAS
  11. '  First Released .....: February 11, 1990
  12. '  Subsequent Releases.: August 26, 1990
  13. '  Copyright ..........: 1986 - 1990
  14. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  15. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  16. '     require error trapping are incorporated within RBBSSUB 2-5 as
  17. '     separately callable subroutines in order to free up as much
  18. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  19. '  Parameters..........: Most parameters are passed via a COMMON statement.
  20. '
  21. ' Subroutine  Line               Function of Subroutine
  22. '   Name     Number
  23. '  BinSearch      63520  Binary searches sorted file for a key value
  24. '  BreakFileName  63300  Break file name into component parts
  25. '  BufAsUnit      63500  Buffer out a string with CR's
  26. '  SetPrompt      63470  Set prompts based on the user's security
  27. '  DoorReturn     63100  Process door requests
  28. '  FdMacExe       63462  Executes a found macro
  29. '  FileSystem     20117  File System for RBBS-PC
  30. '  FindIt         63490  Check whether file exists and if so open as #2
  31. '  FormRead       63420  Read from file into a form
  32. '  LockAppend     63400  Prepare for a file append
  33. '  MacroExe       63460  Execute internal macro rather than user
  34. '  MsgNameMatch   63540  Match name to one in msg header
  35. '  NoPath         63480  Detects whether string has a path in it
  36. '  RestoreCom     63310  Restore comm port after external program
  37. '  ReadMacro      63330  Read and process macro
  38. '  ShellExit      63320  Exit RBBS via shell
  39. '  TakeOffHook    63530  Take modem off hook
  40. '  UnLockAppend   63410  Clean up after file append
  41. '  VerifyAns      63510  Verify that string passes edits
  42. '  WildCard       63200  Match string to a pattern
  43. '
  44. '  $INCLUDE: 'RBBS-VAR.BAS'
  45. '
  46. * REPLACING old line(s) by new
  47. 20119 ZErrCode = 0
  48.       GOTO 20122
  49. '
  50. ' *****  SCAN DIRECTORIES (PRINT TEXT)  ****
  51. '
  52. * ------[ first line different ]------
  53. '  (formerly lines 7000 to 7260 in RBBS-PC.BAS CPC16-1A
  54. * REPLACING old line(s) by new
  55. 20120 ZOutTxt$ = "Scanning Directory " + _
  56.            ZFileNameHold$
  57.       IF WasRS$ <> "" THEN _
  58.          ZOutTxt$ = ZOutTxt$ + " for " + WasRS$
  59.       GOSUB 21650
  60.       IF ZFileSysParm > 1 THEN _
  61.          RETURN
  62. * ------[ first line different ]------
  63.       CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse)                 ' KG040901
  64.       IF ZNo THEN _                                                  ' KG040901
  65.          ZErrCode = 0 : _                                            ' KG040901
  66.          RETURN                                                      ' KG040901
  67.       WasPG = ZTrue
  68. * REPLACING old line(s) by new
  69. 20122 CALL OpenWork (2,ZFileName$)
  70.       IF ZErrCode = 53 THEN _
  71.          ZOutTxt$ = "Missing File " + ZFileName$ : _
  72.          CALL UpdtCalr (ZOutTxt$,2) : _
  73.          ZOutTxt$ = ZOutTxt$ + _
  74.               ". Please tell SYSOP" : _
  75.          GOSUB 21650 : _
  76.          RETURN
  77.       ZJumpSupported = ZTrue
  78.       ZJumpLast$ = ""
  79.       LastOK = ZFalse
  80. * ------[ first line different ]------
  81.       ZJumpSearching = ZFalse                                        ' ML071502
  82. * REPLACING old line(s) by new
  83. 20159 IF ZAnsIndex < ZLastIndex THEN _
  84.          GOTO 20155
  85.       ZSearchingAll = ZFalse
  86.       CALL CmdStackPushPop (1)
  87.       ZLastIndex = 0
  88.       IF ZNo OR (ZFileNameHold$ = ZDirPrefix$) THEN _
  89.          GOTO 20155
  90.       CALL QuickTPut (ZEmphasizeOff$,0)
  91. * ------[ first line different ]------
  92.       ZOutTxt$ = "End list.  R)elist, [Q]uit, or file(s) to dwnld"   ' KG082004
  93.       ZStackC = ZTrue
  94.       GOSUB 21668
  95.       CALL AllCaps (ZUserIn$(1))
  96.       IF ZUserIn$(1) = "R" THEN _
  97.          ZUserIn$(ZAnsIndex) = WasA1$ : _
  98.          GOTO 20161
  99.       IF LEN(ZUserIn$(1)) > 1 AND _
  100.          ZUserSecLevel >= ZOptSec(19 - 20 * (ZMenuIndex = 6)) THEN _
  101.          ZAnsIndex = 1 : _
  102.          GOSUB 20202
  103.       CALL CmdStackPushPop (2)
  104.       RETURN
  105. * REPLACING old line(s) by new
  106. 20222 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + _
  107.                       ((ZUserSecLevel < ZMinSecToView) OR _
  108. * ------[ first line different ]------
  109.                        NOT ZCanDnldFromUp),MarkingTime,"D")          ' KG022204
  110. * REPLACING old line(s) by new
  111. 20247 ZWasDF = 0
  112.       CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZFalse)
  113.       IF ZAutoDownInProgress THEN _
  114. * ------[ first line different ]------
  115.          ZUserIn$(ZAnsIndex) = WasX$ + "." + Extension$ : _          ' RH022501
  116.          ZOutTxt$ = "Transferring -- " + _
  117.               ZUserIn$(ZAnsIndex) : _                                ' RH022501
  118.          GOSUB 21640 : _
  119.          IF ZFileSysParm > 1 THEN _
  120.             RETURN
  121.       IF INSTR("...WRK.FW .ARC.EXE.COM.OBJ.WKS.LBR.ZIP.PAK.ZOO.LZH.","."+Extension$+".") > 2 OR _
  122.          MID$(Extension$,2,1) = "Q" OR _
  123.          (ZRequireNonASCII AND Extension$ = "BAS") THEN _
  124.             ZWasDF = ZTrue
  125. * REPLACING old line(s) by new
  126. 20262 IF ZBatchTransfer THEN _
  127.          IF ZAnsIndex < LastDnld THEN _
  128.             RETURN _
  129.          ELSE ZBlocksInFile# = BatchBlocks# : _
  130.               ZBytesInFile# = BatchBytes# : _
  131.               ZNumDnldBytes! = BatchBytes# : _
  132.               IF ZBytesInFile# < 1 THEN _
  133.                  RETURN _
  134.               ELSE GOSUB 20780 : _
  135.                    IF ZFileSysParm > 1 OR NOT ZOK THEN _
  136.                       RETURN
  137.       IF ZAutoDownInProgress THEN _
  138.          CALL SendName : _
  139.          IF ZAbort THEN _
  140.             DnldCompleted = ZFalse : _
  141.             GOSUB 21760 : _
  142.             RETURN
  143. * ------[ first line different ]------
  144.       GOSUB 20337                                                    ' XX081401
  145.       CALL Transfer
  146. * REPLACING old line(s) by new
  147. 20263 IF ZPrivateDoor THEN _
  148.          ZCmdTransfer$ = ZWasFT$ : _
  149.          CALL XferType (2,ZTrue) : _
  150.          ZCmdTransfer$ = ""
  151.       CALL OpenWork (2,"XFER-" + ZNodeID$ + ".DEF")
  152.       IF ZErrCode <> 0 THEN _
  153.          GOTO 20267
  154.       CALL ReadParms (ZWorkAra$(), ZFailureParm, 1)
  155.       IF ZErrCode <> 0 THEN _
  156.          GOTO 20267
  157. * ------[ first line different ]------
  158.       CLOSE 2                                                        ' KG040902
  159.       CALL KillWork ("XFER-" + ZNodeID$ + ".DEF")
  160. * REPLACING old line(s) by new
  161. 20330 IF ZAutoDownInProgress THEN _
  162.          RETURN
  163. * ------[ first line different ]------
  164.       GOSUB 20337                                                    ' KG032801
  165.       ZOutTxt$ = ZProtoPrompt$ + _
  166.             " " + WasA1$ + _
  167.             " of " + _
  168.             ZFileNameHold$ + _
  169.             " ready.  <Ctrl X> aborts"
  170.       GOSUB 21650
  171. * REPLACING old line(s) by new
  172. 20335 IF ZTransferFunction = 1 THEN _
  173.          CALL Talk (8,ZOutTxt$) _
  174.       ELSE CALL Talk (9,ZOutTxt$)
  175.       RETURN
  176. * ------[ first line different ]------
  177. * INSERTING new line(s)
  178. 20337 IF ZProtoMacro$ <> "" THEN _                                   ' KG032801
  179.          ZGSRAra$(1) = MID$("DU ",ZTransferFunction,1) : _           ' KG032801
  180.          CALL MacroExe (ZProtoMacro$)                                ' KG032801
  181.       RETURN                                                         ' KG032801
  182. '
  183. ' *  ASCII DOWNLOAD DRIVER
  184. '
  185. * REPLACING old line(s) by new
  186. 20340 IF ZWasDF THEN _
  187.          ZOutTxt$ = "Switch to a non-ascii protocol" : _
  188.          GOSUB 21650 : _
  189.          GOTO 21700
  190.       GOSUB 20750
  191.       IF ZFileSysParm > 1 OR NOT ZOK THEN _
  192.          RETURN
  193.       CALL OpenWork (2,ZFileName$)
  194.       IF (ZAnsIndex = FirstDnld OR NOT ZConcatFIles) THEN _
  195. * ------[ first line different ]------
  196.          GOSUB 20337 : _                                             ' KG032801
  197.          ZOutTxt$ = "^X aborts.  ^S suspends ^Q resumes" : _
  198.          GOSUB 21640 : _
  199.          IF ZFileSysParm > 1 THEN _
  200.             RETURN _
  201.          ELSE ZOutTxt$ = ZProtoPrompt$ + " SEND of " + _
  202.               ZFileNameHold$ + _
  203.               " ready. Press Any Key to start" : _
  204.          ZTurboKey = 2 : _
  205.          ZForceKeyboard = ZTrue : _
  206.          ZSuspendAutologoff = ZTrue : _
  207.          GOSUB 21660 : _
  208.          ZSuspendAutologoff = ZFalse : _
  209.          GOSUB 20335 : _
  210.          IF ZFileSysParm > 1 THEN _
  211.             RETURN
  212. * REPLACING old line(s) by new
  213. 20430 ZAnsIndex = ZLastIndex
  214.       GOSUB 20470
  215.       ZLastIndex = ZLastIndex + (WasX > 0)
  216. * ------[ first line different ]------
  217.       LastUpld = ZLastIndex                                          ' KG072702
  218. * INSERTING new line(s)
  219. 20432 FOR ZAnsIndex = FirstUpld TO LastUpld                          ' KG072702
  220.          GOSUB 20470
  221.          GOSUB 20435
  222.          FirstUpld = FirstUpld + 1                                   ' KG072702
  223.          IF ZFileSysParm > 1 THEN _
  224.             ZAnsIndex = LastUpld + 1                                 ' KG072702
  225.       NEXT
  226.       ZCmdTransfer$ = ""
  227.       RETURN
  228. * REPLACING old line(s) by new
  229. 20435 ZFileNameHold$ = ZUserIn$(ZAnsIndex)
  230. * ------[ first line different ]------
  231.       ExtSrch = ZFalse                                               ' ML080601
  232.       IF INSTR(ZFileNameHold$,".") = 0 THEN _
  233.          ZFileNameHold$ = ZFileNameHold$ + "." + ZDefaultExtension$
  234.       CALL AllCaps(ZFileNameHold$)
  235.       ZFileName$ = ZFileNameHold$
  236.       ZViolation$ = "Upload "
  237.       CALL NoPath (ZFileName$,BadFileNameIndex)
  238.       IF BadFileNameIndex THEN _
  239.          GOTO 20451
  240.       CALL BadFile (ZFileName$,BadFileNameIndex)
  241.       ON BadFileNameIndex GOTO 20440,20451,20515
  242. * REPLACING old line(s) by new
  243. 20440 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount,ZTrue,"U")  ' KG022204
  244. * REPLACING old line(s) by new
  245. 20450 IF Extension$ <> Check$ THEN _
  246. * ------[ first line different ]------
  247.          CALL RotorsDir (WasX$ + "." + Check$,ZSubDir$(),ZSubDirCount,ZTrue,"U") : _ ' KG021802
  248.          IF ZOK THEN _
  249.             ExtSrch = ZTrue : _                                      ' ML080601
  250.             GOTO 20452
  251.       GOTO 20447
  252. * REPLACING old line(s) by new
  253. 20452 IF ZUserSecLevel < ZOverWriteSecLevel THEN _
  254.          GOTO 20453
  255. * ------[ first line different ]------
  256.       IF ExtSrch AND (WasX$ + "." + Check$) <> ZFileName$ THEN _     ' ML080601
  257.          ZOutTxt$ = WasX$ + "." + Check$ + " already here, " + _     ' ML080601
  258.                     "upload anyway (Y,[N])" _                        ' ML080601
  259.       ELSE ZOutTxt$ = "Overwrite file (Y,[N])"                       ' ML080601
  260.       GOSUB 21660
  261.       IF ZFileSysParm > 1 THEN _
  262.          RETURN
  263.       IF NOT ZYes THEN _
  264.          GOTO 20453
  265.       ZWasZ$ = ZFileName$
  266.       CALL KillWork (ZFileName$)
  267.       IF ZErrCode <> 0 AND ZErrCode <> 53 THEN _                     ' ML080601
  268.          ZOutTxt$ = "Unable to overwrite" : _                        ' ML080601
  269.          GOSUB 21660 : _                                             ' ML080601
  270.          RETURN                                                      ' ML080601
  271.       GOTO 20475
  272. * REPLACING old line(s) by new
  273. 20560 LineACK = (ZDefaultLineACK$ <> "")
  274.       IF LineACK THEN _
  275.          ZOutTxt$ = "Acknowledge each line ([Y],N)" : _
  276.          ZTurboKey = - ZTurboKeyUser : _
  277.          LineACK = NOT ZNo : _
  278.          GOSUB 21660 : _
  279.          IF ZFileSysParm > 1 THEN _
  280.             RETURN
  281. * ------[ first line different ]------
  282.       GOSUB 20337                                                    ' KG032801
  283.       CALL QuickTPut1 ("Transfer MUST end with a <Ctrl-K>")
  284.       CALL QuickTPut1 (ZProtoPrompt$+" RECEIVE of " + ZFileNameHold$ + " ready")
  285.       ZOK = ZFalse
  286.       XOff = ZFalse
  287.       CALL OpenOutW(ZFileName$)
  288.       IF ZErrCode <> 0 AND ZErrCode <> 53 THEN _
  289.          ZWasEL = 20560 : _
  290.          GOTO 21900
  291.       GOSUB 20510
  292.       IF ZFileSysParm > 1 THEN _
  293.          RETURN
  294. * REPLACING old line(s) by new
  295. 20705 ZMaxMsgLines = ZMaxMsgLinesDef
  296.       ZRightMargin = WasLL
  297. * ------[ first line different ]------
  298.       GOSUB 20702                                                    ' KG072702
  299.       GOTO 20432                                                     ' KG072702
  300. * REPLACING old line(s) by new
  301. 20735 CALL KillWork (ZFileName$)
  302.       IF ZErrCode <>0 THEN _
  303.          ZWasEL = 20736 : _
  304.          GOTO 21900
  305. * ------[ first line different ]------
  306.       ZAnsIndex = ZLastIndex + 1                                     ' KG031501
  307.       ZLastIndex = 0
  308.       RETURN
  309. '
  310. ' *  Sysop ABORTED UPLOAD
  311. '
  312. * REPLACING old line(s) by new
  313. 20745 ZOutTxt$ = ZXOff$ + _
  314. * ------[ first line different ]------
  315.            "SYSOP aborted upload. Stop transfer. <Ctrl-K> continues" ' KG081701
  316.       GOTO 20675
  317. '
  318. ' *  CALCULATE DOWNLOAD TIME ESTIMATE
  319. '
  320. * REPLACING old line(s) by new
  321. 20760 IF ZErrCode <> 0 THEN _
  322.          CALL QuickTPut1 ("Unable to access "+ZFileNameHold$) : _
  323.          CALL UpdtCalr ("Unable to access "+ZFileName$,2) : _
  324.          ZOK = ZFalse : _
  325.          ZErrCode = 0 : _
  326.          ZBytesInFile# = 0 : _
  327.          RETURN
  328.       ZBytesInFile# = LOF(2)
  329.       ZNumDnldBytes! = LOF(2)
  330.       ZOK = ZTrue
  331.       IF SizeOnly THEN _
  332.          SizeOnly = ZFalse : _
  333.          RETURN
  334.       ZBlocksInFile# = MaxBlock
  335.       IF ZBatchTransfer THEN _
  336.          Temp# = BatchBlocks# + ZBlocksInFile# : _
  337.          CALL CheckTimeRemain (MinsRemaining) : _
  338.          IF (NOT PersonalDnld) AND _
  339.             (INT(Temp# / 60) + 1 > MinsRemaining) THEN _
  340.             CALL QuickTPut1 ("Omitting " + ZFileNameHold$ + ".  Insufficient time") : _
  341. * ------[ first line different ]------
  342.             ZAutoLogoffReq = ZFalse : _                              ' KG073001
  343.             RETURN _
  344.          ELSE BatchBlocks# = Temp# : _
  345.               BatchBytes# = BatchBytes# + ZBytesInFile# : _
  346.               CALL OpenWorkA (ZNodeWorkFile$) : _
  347.               CALL PrintWorkA (ZFileName$) : _
  348.               ZDownFiles = ZDownFiles + 1 : _
  349.               RETURN
  350.       ZDownFiles = 1
  351. * REPLACING old line(s) by new
  352. * ------[ first line different ]------
  353. 21810 ZOutTxt$ = "Search string or filename (wildcards OK), [ENTER] quits)"  ' DA071701
  354.       ZMacroMin = 99
  355.       GOSUB 21668
  356.       IF ZWasQ = 0 THEN _
  357.          RETURN
  358. * REPLACING old line(s) by new
  359. 21820 WasRS$ = ZUserIn$(ZAnsIndex)
  360.       WildSearch = (INSTR(WasRS$,"*") > 0 OR INSTR(WasRS$,"?") > 0)
  361.       CALL AllCaps (WasRS$)
  362. * ------[ first line different ]------
  363.       IF RIGHT$(WasRS$,1) = "*" THEN _                               ' KG081201
  364.          IF RIGHT$(WasRS$,2) <> ".*" THEN _                          ' KG081201
  365.             WasRS$ = WasRS$ + ".*"                                   ' KG081201
  366.       SearchString$ = WasRS$
  367.       SearchDate$ = ""
  368.       ZJumpSearching = ZFalse
  369.       WasA1$ = WasRS$
  370.       GOTO 21867
  371. '
  372. ' *****  P - personal download  ****
  373. '
  374. '  (formerly lines 52950 to 52952 in RBBS-PC.BAS
  375. * REPLACING old line(s) by new
  376. 21900 IF ZDebug THEN _
  377.          ZOutTxt$ = "RBBSSUB5 DEBUG Error Trap Entry ERL=" + _
  378.               STR$(ZWasEL) + _
  379.               " ERR=" + _
  380.               STR$(ZErrCode) : _
  381.          IF ZPrinter THEN _
  382.             CALL Printit(ZOutTxt$) _
  383.          ELSE CALL LPrnt(ZOutTxt$,1)
  384.       IF ZWasEL = 20126 AND ZErrCode = 53 THEN _
  385.          GOTO 20142
  386.       IF ZWasEL = 20242 AND ZErrCode = 62 THEN _
  387.          CALL UpdtCalr (ZFileSecFile$ + " bad format!",2) : _
  388.          GOTO 20247
  389.       IF ZWasEL = 20263 THEN _
  390.          ZOutTxt$ = "<Download aborted>" : _
  391.          DnldCompleted = ZFalse : _
  392. * ------[ first line different ]------
  393.          GOTO 20390                                                  ' ML080601
  394.       IF ZWasEL = 20560 AND ZErrCode = 67 THEN _
  395.          GOTO 20451
  396.       IF ZWasEL = 20560 AND ZErrCode = 70 THEN _
  397.          IF VAL(ZFreeSpace$) > 1999 THEN _
  398.             GOTO 20610 _
  399.          ELSE CALL QuickTPut1 ("No room for uploads. Try tomorrow.") : _
  400.               GOTO 21700
  401.       IF ZWasEL = 20620 THEN _
  402.          GOTO 20670
  403.       IF ZWasEL = 20650 THEN _
  404.          GOTO 20670
  405.       IF ZWasEL = 20736 AND ZErrCode = 53 THEN _
  406.          GOTO 21700
  407.       IF ZWasEL = 20900 AND ZErrCode = 75 THEN _
  408.          GOTO 21230
  409.       IF ZWasEL = 20900 AND ZErrCode = 70 THEN _
  410.          CALL QuickTPut1 ("No room for uploads. Try tomorrow.") : _
  411.          GOTO 21230
  412.       IF ZWasEL = 21131 OR ZWasEL = 21220 THEN _
  413.          ZErrCode = 0 : _
  414.          GOTO 21230
  415.       IF ZWasEL = 21480 THEN _
  416.          CALL LogError : _
  417.          IF ZErrCode = 57 THEN _
  418.             CALL QuickTPut1 ("Error reading file.  Aborting download") : _
  419.             DnldCompleted = ZFalse : _
  420.             GOTO 21230
  421. * REPLACING old line(s) by new
  422. 63300 ' $SUBTITLE: 'BreakFileName - sub to split file name into components'
  423. ' $PAGE
  424. '
  425. '  NAME    -- BreakFileName
  426. '
  427. '  INPUTS  -- PARAMETER                    MEANING
  428. '             FileSpec$        FULL NAME OF FILE
  429. '             ForJoining       True IF WANT PARTS FORMATTED FOR
  430. '                                           FORMING FILE NAMES
  431. '  OUTPUTS -- DrvPath$         DRIVE AND PATH
  432. '             Prefix$          PREFIX OF FILE NAME
  433. '             Extension$       EXTENSION OF FILE NAME
  434. '
  435. ' (E.G. "C:\RBBS\ARCE.COM" HAS "C:\RBBS" AS DRIVE AND PATH,
  436. '                              "ARCE"    AS PREFIX OF THE FILE NAME, AND
  437. '                              "COM"     AS THE EXTENSION OF THE FILE NAME.
  438. '
  439. ' JOINED FORMAT IS C:\RBBS\,ARCE,.COM
  440. '
  441. '  PURPOSE -- To break a file name into its component parts
  442. '             of drive/path, prefix, and extension
  443. '
  444. '
  445. * ------[ first line different ]------
  446.       SUB BreakFileName (PassedFileSpec$,DrvPath$,Prefix$,Extension$,ForJoining) STATIC ' KG081705
  447.       FileSpec$ = PassedFileSpec$                                    ' KG081705
  448.       CALL AllCaps (FileSpec$)
  449.       DrvPath$ = ""
  450.       Prefix$ = ""
  451.       Extension$ = ""                                                ' KG082301
  452.       WasL = LEN(FileSpec$)
  453.       IF WasL < 1 THEN _
  454.          EXIT SUB
  455.       CALL FindLast (FileSpec$,"\",WasX,WasY)
  456.       IF WasX < 1 THEN _
  457.          IF MID$(FileSpec$,2,1) = ":" THEN _
  458.             DrvPath$ = LEFT$(FileSpec$,2) : _                        ' DA082101
  459.             ZWasS = 3 _
  460.          ELSE ZWasS = 1 _
  461.       ELSE DrvPath$ = LEFT$(FileSpec$,WasX) : _                      ' DA082101
  462.            ZWasS = WasX + 1                                          ' DA082101
  463.       WasX = INSTR(ZWasS,FileSpec$ + ".",".")                        ' EC061301
  464.       IF WasX < WasL THEN _
  465.          Extension$ = MID$(FileSpec$,WasX)                           ' DA082101
  466.       IF ZWasS <= WasL THEN _
  467.          IF WasX >= ZWasS THEN _
  468.             Prefix$ = MID$(FileSpec$,ZWasS,WasX - ZWasS)
  469.       IF ForJoining THEN _                                           ' DA082101
  470.          EXIT SUB
  471.       IF WasY > 1 THEN _                                             ' KG082301
  472.          DrvPath$ = LEFT$(DrvPath$, LEN(DrvPath$) - 1)               ' DA082101
  473.       IF LEN(Extension$) > 0 THEN _
  474.          Extension$ = MID$(Extension$, 2)                            ' DA082101
  475.       END SUB
  476. * REPLACING old line(s) by new
  477. 63320 ' $SUBTITLE: 'ShellExit - sub to shell out from RBBS'
  478. ' $PAGE
  479. '
  480. '  NAME    -- ShellExit
  481. '
  482. '  INPUTS  -- ShellTem$     String to invoke shell with
  483. '
  484. '  OUTPUTS -- none
  485. '
  486. '  PURPOSE -- Delay so that strings can finish printing.  Restore comm
  487. '             port on return
  488. '
  489.       SUB ShellExit (ShellTem$) STATIC
  490.       CALL DelayTime (8 + ZBPS)
  491.       IF NOT ZLocalUser THEN _
  492.          IF ZFossil THEN _
  493.             CALL FOSExit(ZComPort) _
  494.          ELSE CLOSE 3 : _
  495.               OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1
  496.       CLOSE 2
  497.       CALL MetaGSR (ShellTem$,ZFalse)
  498.       SHELL ShellTem$
  499.       IF ZFossil THEN _
  500.          IF NOT ZLocalUser THEN _
  501.             CALL FOSinit(ZComPort,Result) : _
  502.             IF Result = -1 THEN _
  503. * ------[ first line different ]------
  504.                CALL PScrn("ERROR INIT FOSSIL AFT EXTERNAL") : _      ' KG072701
  505.                SYSTEM
  506.       CALL DelayTime (2)
  507.       CALL RestoreCom
  508.       END SUB
  509. * REPLACING old line(s) by new
  510. 63330 ' $SUBTITLE: 'ReadMacro - sub to read macro'
  511. ' $PAGE
  512. '
  513. '  NAME    -- ReadMacro
  514. '
  515. '  INPUTS  -- PARAMETER             MEANING
  516. '
  517. '  OUTPUTS -- ZOutTxt$               LINE TO PROCESS IN MACRO
  518. '             ZMacroActive           FLAG WHETHER IN A MACRO
  519. '
  520. '  PURPOSE -- Reads in a line from macro file (#6) and processes
  521. '             macro commands, which are:
  522. '             *0 - display what follows, no carriage return
  523. '             *1 - display what follows with carriage return
  524. '             *B - display block that follows
  525. '             *F - display File
  526. '             WT - wait specified # of seconds
  527. '             >> - append following block to specified file
  528. '             ST - stack following (with carriage return)
  529. '             ON - define case
  530. '             == - case value that applies to following block
  531. '             M! - execute following macro
  532. '             M@ - abort macro processing
  533. '             EY - Echo on (yes)
  534. '             EN - Echo off (no)
  535. '             /* - comment line skipped in processing
  536. '             TK - Turbo key on (if user preference)
  537. '             << - Read from file into a form
  538. '             := - Assign value to work variable
  539. * ------[ first line different ]------
  540. '             LO - Set the location of a file                        ' KG022301
  541. '
  542.       SUB ReadMacro STATIC
  543.       IF ZMacroTemplate$ <> "" THEN _
  544.          GOTO 63392
  545.       IF ZDistantTGet = 2 THEN _
  546.          GOTO 63349
  547. * REPLACING old line(s) by new
  548. 63336 GOSUB 63395
  549.       IF NOT ZMacroActive THEN _
  550.          ZMacroEcho = ZTrue : _
  551. * ------[ first line different ]------
  552.          EXIT SUB                                                    ' KG042501
  553.       IF CompareVar > 0 THEN _
  554.          IF NOT CaseExecute THEN _
  555.             IF LEFT$(ZOutTxt$,3) = ZSmartTextCode$+"==" THEN _
  556.                WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3) : _          ' KG042501
  557.                GOTO 63370 _
  558.             ELSE IF LEFT$(ZOutTxt$,7) = ZSmartTextCode$ + "END ON" THEN _
  559.                     CompareVar = 0 : _
  560.                     GOTO 63336 _
  561.                   ELSE GOTO 63336
  562.       IF LEN(ZOutTxt$) < 3 THEN _                                    ' KG042501
  563.          GOTO 63398                                                  ' KG042501
  564.       WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3)                       ' KG042501
  565.       IF LEFT$(ZOutTxt$,1) <> ZSmartTextCode$ THEN _
  566.          GOTO 63398
  567.       CALL CheckInt (MID$(ZOutTxt$,2))
  568.       IF ZErrCode > 0 THEN _
  569.          GOTO 63398
  570.       IF ZTestedIntValue > 0 AND ZTestedIntValue <= ZMaxWorkVar THEN _
  571.          ZOutTxt$ = WasX$ : _  ' Macro command ask
  572.          ZForceKeyboard = ZTrue : _
  573.          ZMacroSave = ZTestedIntValue : _
  574.          ZLinesPrinted = 1 : _
  575.          ZNonStop = (ZPageLength < 1) : _
  576.          EXIT SUB
  577.       ON (1+INSTR("*0*1*B*FWT>>STON==M!M@EYEN/*TK<<:=LVNVCVLO",MID$(ZOutTxt$,2,2)))\2 GOTO _ ' KG022301
  578.          63345, _  ' Display with no Carriage Return
  579.          63347, _  ' Display with Carriage Return
  580.          63340, _  ' Display Block
  581.          63348, _  ' Display File
  582.          63343, _  ' Wait # of seconds
  583.          63350, _  ' Append to file
  584.          63355, _  ' Stack
  585.          63360, _  ' Case
  586.          63370, _  ' Case Comparison
  587.          63375, _  ' Macro execute
  588.          63380, _  ' Macro Abort
  589.          63383, _  ' Macro Echo on
  590.          63385, _  ' Macro Echo off
  591.          63336, _  ' Macro Comment
  592.          63387, _  ' Turbo Key allowed
  593.          63390, _  ' Form read
  594.          63362, _  ' Assign value to work var
  595.          63363, _  ' LV list verify
  596.          63364, _  ' NV number verify
  597.          63364, _  ' CV character verify                             ' KG022301
  598.          63367     ' LO assign file location                         ' KG022301
  599.       GOTO 63398
  600. * REPLACING old line(s) by new
  601. * ------[ first line different ]------
  602. 63362 CALL Trim (WasX$)                                              ' KG021803
  603.       CALL CheckInt (WasX$)
  604.       WasX = INSTR(WasX$," ")
  605.       IF WasX > 0 AND ZTestedIntValue > 0 AND ZTestedIntValue <= ZMaxWorkVar THEN _
  606.          ZGSRAra$(ZTestedIntValue) = RIGHT$(WasX$,LEN(WasX$)-WasX)   ' KG021803
  607.       GOTO 63336
  608. * INSERTING new line(s)
  609. 63367 CALL TRIM (WasX$)                                              ' KG022301
  610.       ZFileLocation$ = WasX$                                         ' KG022301
  611.       GOTO 63336                                                     ' KG022301
  612. * REPLACING old line(s) by new
  613. 63522 RecFoundAt = 0
  614. * ------[ first line different ]------
  615.       IF High < 1 THEN _                                             ' KG072102
  616.          EXIT SUB                                                    ' KG072102
  617.       WasX$ = SPACE$ (NumChars)
  618.       Done = ZFalse
  619.       WHILE NOT Done
  620.          WasI = INT(((High + Low) / 2) + .5)
  621.          GET 2, WasI
  622.          LSET WasX$ = MID$(SearchRec$, StartPos, NumChars)
  623.          IF WasX$ = SearchFor$ THEN _
  624.             RecFound$ = SearchRec$: _
  625.             RecFoundAt = WasI : _
  626.             Done = ZTrue _
  627.          ELSE IF (High - Low) < 2 THEN _
  628.                  Done = ZTrue _
  629.               ELSE IF WasX$ < SearchFor$ THEN _
  630.                       Low = WasI _
  631.                    ELSE IF WasX$ > SearchFor$ THEN _
  632.                            High = WasI
  633.       WEND
  634.       END SUB
  635. * REPLACING old line(s) by new
  636. 63540 ' Match Name to one in message file
  637.       SUB MsgNameMatch (PrimeName$,AltName$,SearchPos,Found) STATIC
  638.       WasX$ = LEFT$(PrimeName$+"  ",22-8*(SearchPos < 7))
  639. * ------[ first line different ]------
  640.       GOSUB 63542                                                    ' KG052201
  641.       IF Found OR AltName$ = "" THEN _                               ' KG052201
  642.          EXIT SUB                                                    ' KG052201
  643.       WasX$ = LEFT$(AltName$ + "  ",22-8*(SearchPos < 7))
  644.       GOSUB 63542                                                    ' KG052201
  645.       EXIT SUB                                                       ' KG052201
  646. * INSERTING new line(s)
  647. 63542 WasY$ = MID$(ZMsgRec$,SearchPos,LEN(WasX$))                    ' KG052201
  648.       ZWasDF = INSTR(WasY$,"@")                                      ' KG052201
  649.       IF ZWasDF > 0 THEN _                                           ' KG052201
  650.          MID$(WasY$,ZWasDF) = "      "                               ' KG052201
  651.       Found = (WasY$ = WasX$)                                        ' KG052201
  652.       RETURN                                                         ' KG052201
  653.       END SUB
  654.